home *** CD-ROM | disk | FTP | other *** search
/ PC-SIG Library 8 / PC-SIG Library CD-ROM (8th Edition) (1990-04).iso / 1901_000 / disk1930 / vpp.for < prev   
Encoding:
Text File  |  1988-10-22  |  2.1 KB  |  106 lines
  1.       PROGRAM VPP
  2. C
  3. C     TO TEST DIRECT MEMORY OPERATIONS
  4. C     OLYMPIC SOFTWARE  --  9/27/88
  5. C
  6.       EXTERNAL GBIOS,GETADR,MXFER,MXFER1
  7. C
  8.       INTEGER*4 IS1,IS2
  9.       INTEGER*2 IOF1,IOF2,N,ICNT
  10.       INTEGER*2 IDAT(10000)
  11.       INTEGER*2 IAR(4)
  12. C
  13.       DATA IS2,IOF2,N /47104,0,16384/
  14.  
  15. C***    GET IDAT ADDRESS
  16.       CALL GETADR(IDAT,IS1,IOF1)
  17.         WRITE(*,19)IS1,IOF1
  18.  19     FORMAT(' IDAT IS AT: ',I6,':',I6)
  19. C
  20. C***    CHANGE TO GRAPHICS MODE, MODE=6 (CGA GRAPHICS)
  21.       IAR(1)=0
  22.       IAR(2)=6
  23.       CALL GBIOS(IAR)
  24. C
  25. C***    PLOT VERTICAL LINES
  26.       IAR(1)=12
  27.       IAR(2)=15
  28.       DO 10 J=1,640,2
  29.       DO 10 I=1,200,2
  30.       IAR(3)=J-1
  31.       IAR(4)=I-1
  32.       CALL GBIOS(IAR)
  33.  10   CONTINUE
  34. C
  35. C***    MXFER DATA FROM VIDEO TO IDAT
  36.       CALL MXFER(IS2,IOF2,IS1,IOF1,N)
  37. C
  38. C***    MCLR VIDEO DATA
  39.       CALL MCLR(IS2,IOF2,N)
  40. C
  41.       ICNT=18
  42.       CALL STIMER(ICNT)
  43. C
  44. C***    MXFER1 DATA FROM IDAT TO VIDEO
  45.       IOP=0
  46.       CALL MXFER1(IOP,IDAT,IS2,IOF2,N)
  47. C
  48.       ICNT=18
  49.       CALL STIMER(ICNT)
  50. C
  51. C***    MCLR IDAT DATA
  52.       CALL MCLR(IS1,IOF1,N)
  53. C
  54. C***    MXFER1 DATA FROM VIDEO TO IDAT
  55.       IOP=1
  56.       CALL MXFER1(IOP,IDAT,IS2,IOF2,N)
  57. C
  58. C***    MCLR VIDEO DATA
  59.       CALL MCLR(IS2,IOF2,N)
  60. C
  61.       ICNT=18
  62.       CALL STIMER(ICNT)
  63. C
  64. C***    MXFER DATA FROM IDAT TO VIDEO
  65.       CALL MXFER(IS1,IOF1,IS2,IOF2,N)
  66. C
  67.       ICNT=18
  68.       CALL STIMER(ICNT)
  69. C
  70. C***    CHANGE TO TEXT MODE, MODE=3
  71.       IAR(1)=0
  72.       IAR(2)=3
  73.       CALL GBIOS(IAR)
  74. C
  75.       STOP
  76.       END
  77. C
  78.       SUBROUTINE STIMER(ICNT)
  79. C
  80. C     SHORT INTERVAL TIMER ROUTINE
  81. C     PROGRAM ENDS AFTER ICNT COUNTS (TOTAL DELAY <1 HOUR)
  82. C     INTERVAL : 1/18 SEC
  83. C     MIDNIGHT CROSSING RESETS STIMER (STIMER RETURNS)
  84. C     OLYMPIC SOFTWARE  --  9/26/88
  85. C
  86.       EXTERNAL TBIOS
  87.       INTEGER*2 IAR(6),ICX,IDX,EC,ICNT
  88. C
  89.       IAR(1)=0
  90.       CALL TBIOS(IAR)
  91.       IDX=IAR(5)*256+IAR(6)
  92.       IAR(1)=0
  93.  100  CALL TBIOS(IAR)
  94.       EC=IAR(5)*256+IAR(6)-IDX
  95.       IF(EC.LT.0)EC=EC+4*16384
  96.       IF(IAR(2).NE.0)GOTO 200
  97.       IF(EC.LT.ICNT)GOTO 100
  98. C
  99.  200  RETURN
  100.       END
  101.  
  102.  
  103.  
  104.  
  105.  
  106.